home *** CD-ROM | disk | FTP | other *** search
/ Internet Surfer: Getting Started / Internet Surfer - Getting Started (Wayzata Technology)(7231)(1995).bin / pc / mac / bonus / peter_le / dehqx-20 / myutilit.uni < prev    next >
Text File  |  1991-08-23  |  10KB  |  382 lines
  1. unit MyUtilities;
  2. { DeHQX v2.0.0 ⌐ Peter Lewis, Aug 1991 }
  3.  
  4. interface
  5.  
  6.     uses
  7.         GestaltEqu, Traps, MyTypes;
  8.  
  9.     const
  10.         about_dialog_ID = 128;
  11.         help_dialog_ID = 129;
  12.  
  13.     var
  14.         sysenv: sysEnvRec; { * - Setup by InitUtilities }
  15.         system7: boolean;
  16.         has_waitNextEvent: boolean; { * }
  17.         has_appleEvents: boolean; { * }
  18.         has_gestalt: boolean; { * }
  19.         has_findfolder: boolean; { * }
  20.         has_newStdFile: boolean; { * }
  21.         has_HelpMgr: boolean; { * }
  22.         in_foreground: boolean; { * }
  23.         about_dialog, help_dialog: dialogPtr;
  24.  
  25.     type
  26.         versionRecord = packed record
  27.                 version: integer;
  28.                 devcode: byte;
  29.                 revision: byte;
  30.                 country: integer;
  31.                 short: str15;
  32.                 long: str255;
  33.             end;
  34.  
  35.     procedure InitUtilities;
  36.     function Gestalt (selector: OSType; var response: LONGINT): OSErr;
  37.     function TrapAvailable (tNumber: INTEGER): BOOLEAN; { * }
  38.     function WaitGetNextEvent (em: integer; var er: eventRecord; sleep: longInt; rgn: rgnHandle): boolean; { * }
  39.     function MyNumToString (n: longInt): str255;
  40.     function CheckCancel: boolean;
  41.     procedure DotDotDot (var s: str255; var width: integer);
  42.     procedure SetItemEnable (mh: menuHandle; item: integer; enable: boolean);
  43.     procedure DotItem (mh: menuHandle; item: integer; dotted: boolean);
  44.     procedure DoHelp;
  45.     procedure DoAbout;
  46.     function SimpleClose (wp: windowPtr): boolean;
  47.         { return true if you have to do something }
  48.     function MyFrontWindow: boolean;
  49.     function DAFrontWindow: boolean;
  50.     function GetIndStrSize (size, id, index: integer): str255;
  51.     procedure GetVersion (var vers: versionRecord);
  52.     procedure SetVersionParamText (c2, c3: str255);
  53.     function GetDirID (wdrn: integer; var vrn: integer; var dirID: longInt): OSErr;
  54.     procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
  55.     function GetVolInfo (var name: str63; var vrn: integer; index: integer; var CrDate: longInt): OSErr;
  56.     procedure OutlineDefault1 (dp: dialogPtr; item: integer);
  57.     procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
  58.     procedure FlashItem (dlg: dialogPtr; item: integer);
  59.  
  60. implementation
  61.  
  62.     function TrapAvailable (tNumber: INTEGER): BOOLEAN;
  63. {Check to see if a given trap is implemented. Babble as taken from IM6 }
  64.         const
  65.             TrapMask = $0800;
  66.         var
  67.             tType: TrapType;
  68.             ignoreError: OSErr;
  69.     begin
  70.         if BAND(tNumber, TrapMask) > 0 then
  71.             tType := ToolTrap
  72.         else
  73.             tType := OSTrap;
  74.         if tType = ToolTrap then begin
  75.             tNumber := BAND(tNumber, $7FF);
  76.             if tNumber >= $400 then
  77.                 tNumber := _Unimplemented
  78.             else if tNumber >= $200 then
  79.                 if NGetTrapAddress($A86E, ToolTrap) <> NGetTrapAddress($AA6E, ToolTrap) then
  80.                     tNumber := _Unimplemented;
  81.         end;
  82.         TrapAvailable := NGetTrapAddress(tNumber, tType) <> GetTrapAddress(_Unimplemented);
  83.     end; {TrapAvailable}
  84.  
  85.     function Gestalt (selector: OSType; var response: LONGINT): OSErr;
  86.     begin
  87.         if has_gestalt then
  88.             Gestalt := XGestalt(selector, response)
  89.         else
  90.             Gestalt := gestaltUnknownErr;
  91.     end;
  92.  
  93.     procedure InitUtilities;
  94.         var
  95.             oe: OSErr;
  96.             gv: longInt;
  97.     begin
  98.         about_dialog := nil;
  99.         help_dialog := nil;
  100.         oe := SysEnvirons(kSysEnvironsVersion, sysEnv);
  101.         system7 := sysenv.systemVersion >= $0700;
  102.         has_gestalt := TrapAvailable(_Gestalt);
  103.         has_waitNextEvent := TrapAvailable(_WaitNextEvent);
  104.         in_foreground := true;
  105.         oe := Gestalt(gestaltAppleEventsAttr, gv);
  106.         has_appleEvents := (oe = noErr) and (gv = 1);
  107.         oe := Gestalt(gestaltFindFolderAttr, gv);
  108.         has_findfolder := (oe = noErr) and (BTST(gv, gestaltFindFolderPresent));
  109.         oe := Gestalt(gestaltStandardFileAttr, gv);
  110.         has_newStdFile := (oe = noErr) and (BTST(gv, gestaltStandardFile58));
  111.         oe := Gestalt(gestaltHelpMgrAttr, gv);
  112.         has_HelpMgr := (oe = noErr) and (BTST(gv, gestaltHelpMgrPresent));
  113.     end;
  114.  
  115.     function WaitGetNextEvent (em: integer; var er: eventRecord; sleep: longInt; rgn: rgnHandle): boolean;
  116.     begin
  117.         if has_waitNextEvent then begin    {put us to sleep forever under MultiFinder}
  118.             WaitGetNextEvent := WaitNextEvent(em, er, sleep, nil);
  119.         end
  120.         else begin
  121.             SystemTask;                    {must be called if using GetNextEvent}
  122.             WaitGetNextEvent := GetNextEvent(em, er);
  123.         end;
  124.     end;
  125.  
  126.     function MyNumToString (n: longInt): str255;
  127.         var
  128.             s: str255;
  129.     begin
  130.         if abs(n) < 4096 then
  131.             NumToString(n, s)
  132.         else if abs(n) < 4194304 then begin
  133.             NumToString(n div 1024, s);
  134.             s := Concat(s, 'k');
  135.         end
  136.         else begin
  137.             NumToString(n div 1048576, s);
  138.             s := Concat(s, 'M');
  139.         end;
  140.         MyNumToString := s;
  141.     end;
  142.  
  143.     function CheckCancel: boolean;
  144.         var
  145.             er: eventRecord;
  146.     begin
  147.         if GetNextEvent(everyEvent, er) then
  148.             with er do
  149.                 CheckCancel := (what = keyDown) and (BAND(message, charCodeMask) = ord('.')) and (BAND(modifiers, cmdKey) <> 0)
  150.         else
  151.             CheckCancel := false;
  152.     end;
  153.  
  154.     procedure DotDotDot (var s: str255; var width: integer);
  155.         var
  156.             maxwidth, len: integer;
  157.     begin
  158.         maxwidth := width;
  159.         width := StringWidth(s);
  160.         if width > maxwidth then begin
  161.             width := width + CharWidth('╔');
  162. {$PUSH}
  163. {$R-}
  164.             len := ord(s[0]);
  165.             while (len > 0) and (width > maxwidth) do begin
  166.                 width := width - CharWidth(s[len]);
  167.                 len := len - 1;
  168.             end;
  169.             len := len + 1;
  170.             s[0] := chr(len);
  171.             s[len] := '╔';
  172. {$POP}
  173.         end;
  174.     end;
  175.  
  176.     procedure SetItemEnable (mh: menuHandle; item: integer; enable: boolean);
  177.     begin
  178.         if enable then
  179.             EnableItem(mh, item)
  180.         else
  181.             DisableItem(mh, item);
  182.     end;
  183.  
  184.     procedure DotItem (mh: menuHandle; item: integer; dotted: boolean);
  185.     begin
  186.         if dotted then
  187.             SetItemMark(mh, item, 'Ñ')
  188.         else
  189.             SetItemMark(mh, item, chr(0));
  190.     end;
  191.  
  192.     procedure DoAbout;
  193.     begin
  194.         if about_dialog <> nil then begin
  195.             if FrontWindow <> about_dialog then
  196.                 SelectWindow(about_dialog);
  197.         end
  198.         else begin
  199.             SetVersionParamText('', '');
  200.             about_dialog := GetNewDialog(about_dialog_id, nil, POINTER(-1));
  201.         end;
  202.     end;
  203.  
  204.     procedure DoHelp;
  205.         var
  206.             a: integer;
  207.     begin
  208.         if help_dialog <> nil then begin
  209.             if FrontWindow <> help_dialog then
  210.                 SelectWindow(help_dialog);
  211.         end
  212.         else begin
  213.             SetVersionParamText('', '');
  214.             help_dialog := GetNewDialog(help_dialog_id, nil, POINTER(-1));
  215.         end;
  216.     end;
  217.  
  218.     function SimpleClose (wp: windowPtr): boolean;
  219.         { return true if you have to do something }
  220.     begin
  221.         if wp = about_dialog then begin
  222.             DisposDialog(about_dialog);
  223.             about_dialog := nil;
  224.             SimpleClose := false;
  225.         end
  226.         else if wp = help_dialog then begin
  227.             DisposDialog(help_dialog);
  228.             help_dialog := nil;
  229.             SimpleClose := false;
  230.         end
  231.         else
  232.             SimpleClose := true;
  233.     end;
  234.  
  235.     function MyFrontWindow: boolean;
  236.         var
  237.             wp: windowPtr;
  238.     begin
  239.         wp := FrontWindow;
  240.         if wp = nil then
  241.             MyFrontWindow := false
  242.         else
  243.             MyFrontWindow := windowPeek(wp)^.windowKind >= userKind;
  244.     end;
  245.  
  246.     function DAFrontWindow: boolean;
  247.         var
  248.             wp: windowPtr;
  249.     begin
  250.         wp := FrontWindow;
  251.         if wp = nil then
  252.             DAFrontWindow := false
  253.         else
  254.             DAFrontWindow := windowPeek(wp)^.windowKind < 0;
  255.     end;
  256.  
  257.     function GetIndStrSize (size, id, index: integer): str255;
  258.         var
  259.             s255: str255;
  260.     begin
  261.         GetIndString(s255, id, index);
  262.         GetIndStrSize := copy(s255, 1, size - 1);
  263.     end;
  264.  
  265.     procedure GetVersion (var vers: versionRecord);
  266.         var
  267.             vh: handle;
  268.     begin
  269.         with vers do begin
  270.             vh := GetResource('vers', 1);
  271.             if vh = nil then begin
  272.                 version := $0000;
  273.                 devcode := $20;
  274.                 revision := $00;
  275.                 country := 0;
  276.                 short := '0.0.0';
  277.                 long := 'Unknown v0.0.0';
  278.             end
  279.             else begin
  280.                 BlockMove(vh^, @vers, sizeof(vers));
  281. {$PUSH}
  282.  {$R-}
  283.                 BlockMove(Ptr(longint(vh^) + (longint(@short) - longint(@vers)) + ord(short[0]) + 1), @long, sizeof(long));
  284.                 if ord(short[0]) >= sizeof(short) then
  285.                     short[0] := chr(sizeof(short) - 1);
  286. {$POP}
  287.                 ReleaseResource(vh);
  288.             end;
  289.         end;
  290.     end;
  291.  
  292.     procedure SetVersionParamText (c2, c3: str255);
  293.         var
  294.             vers: versionRecord;
  295.     begin
  296.         GetVersion(vers);
  297.         ParamText(vers.short, vers.long, c2, c3);
  298.     end;
  299.  
  300.     function GetDirID (wdrn: integer; var vrn: integer; var dirID: longInt): OSErr;
  301.         var
  302.             procID: longInt;
  303.             oe: OSErr;
  304.     begin
  305.         oe := GetWDInfo(wdrn, vrn, dirID, procID);
  306.         if oe <> noErr then begin
  307.             vrn := wdrn;
  308.             dirID := 0;
  309.         end;
  310.         GetDirID := oe;
  311.     end;
  312.  
  313.     procedure SetItemText (dlg: dialogPtr; item: integer; text: str255);
  314.         var
  315.             it: integer;
  316.             ih: handle;
  317.             box: rect;
  318.             oldtext: str255;
  319.     begin
  320.         GetDItem(dlg, item, it, ih, box);
  321.         GetIText(ih, oldtext);
  322.         if oldtext <> text then
  323.             SetIText(ih, text);
  324.     end;
  325.  
  326.     function GetVolInfo (var name: str63; var vrn: integer; index: integer; var CrDate: longInt): OSErr;
  327.         var
  328.             pb: paramBlockRec;
  329.             oe: OSErr;
  330.     begin
  331.         with pb do begin
  332.             pb.ioNamePtr := @name;
  333.             ioVRefNum := vrn;
  334.             ioVolIndex := index;
  335.             oe := PBGetVInfo(@pb, false);
  336.             if oe = noErr then begin
  337.                 vrn := ioVRefNum;
  338.                 CrDate := ioVCrDate;
  339.             end;
  340.         end;
  341.         GetVolInfo := oe;
  342.     end;
  343.  
  344.     procedure OutlineDefault1 (dp: dialogPtr; item: integer);
  345.         var
  346.             kind: integer;
  347.             h: handle;
  348.             r: rect;
  349.     begin
  350.         GetDItem(dp, 1, kind, h, r);
  351.         PenSize(3, 3);
  352.         InsetRect(r, -4, -4);
  353.         FrameRoundRect(r, 16, 16);
  354.     end;
  355.  
  356.     procedure SetUpDefaultOutline (dp: dialogPtr; def_item, user_item: integer);
  357.         var
  358.             kind: integer;
  359.             h: handle;
  360.             r: rect;
  361.     begin
  362.         if def_item <> 1 then
  363.             DebugStr('MyUtilities:SetUpDefaultOutline:Cant handle anything except 1 yet');
  364.         GetDItem(dp, user_item, kind, h, r);
  365.         InsetRect(r, -10, -10);
  366.         SetDItem(dp, user_item, userItem, handle(@OutlineDefault1), r);
  367.     end;
  368.  
  369.     procedure FlashItem (dlg: dialogPtr; item: integer);
  370.         var
  371.             kind: integer;
  372.             h: handle;
  373.             r: rect;
  374.             f: longInt;
  375.     begin
  376.         GetDItem(dlg, item, kind, h, r);
  377.         HiliteControl(controlHandle(h), 1);
  378.         Delay(2, f);
  379.         HiliteControl(controlHandle(h), 0);
  380.     end;
  381.  
  382. end.